home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0063_VGA Lines.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-02  |  5KB  |  160 lines
  1. {
  2. ANDREW WOOLFSON
  3.  
  4. I recall certain people discussing ways of drawing LINES in Pascal.
  5. Unfortunately I'v lost the thread of those messages - BUT thought I could
  6. add my endevours to this same task.
  7. I hope this helps someone.
  8.  
  9. }
  10. Program VGA_Line_Demo;
  11. (***************************************************************************)
  12. (* Designed, thought out and programmed by Andrew Woolfson {using TP v6.0} *)
  13. (*                                                                         *)
  14. (* Because you have lost all those handy Borland Graphic Functions, I have *)
  15. (* had to redesign the second elementary function in graphics : THE LINE   *)
  16. (* This proved very difficult, and so far this program is a example of the *)
  17. (* best I have managed to do (using vector mathematics).                   *)
  18. (*                                                                         *)
  19. (* This program also shows VGA direct screen addressing in 320x200x256     *)
  20. (* mode.                                                                   *)
  21. (*                                                                         *)
  22. (* I have not documented this program, as I feel it it fairly explanatory. *)
  23. (* If you Do not understand any routine, dont hesitate to ask.             *)
  24. (*            Please share your experiments as I have.                     *)
  25. (***************************************************************************)
  26.  
  27. Uses
  28.   Crt, Graph, DOS;
  29.  
  30. Var
  31.   x, y, Loop : Integer;
  32.   Key        : Char;
  33.   Pixels     : Array [0..199,0..319] OF BYTE ABSOLUTE $A000:0000;
  34.                        { NOTE: Y & X Coord's have been swapped }
  35.  
  36. Procedure InitializeVGA;
  37. Var
  38.   GraphDriver  : Integer;
  39.   GraphMode    : Integer;
  40.   PathtoDriver : String[8];
  41.   Regs         : Registers;
  42. Begin
  43.   GraphDriver := VGA;
  44.   GraphMode   := VGAHi;
  45.   InitGraph(GraphDriver, GraphMode, 'e:\bp\bgi');
  46.  
  47.   Regs.AX := 19;
  48.   intr($10, Regs);     { Interrupt 16 }
  49. End;
  50.  
  51. Procedure Plot(X, Y, Color : Integer);
  52. Begin
  53.   Pixels[Y,X] := Color;
  54. End;
  55.  
  56. Procedure Line(x1, y1, x2, y2, Color : Integer);
  57. Var
  58.   Loop,
  59.   tx, ty   : Integer;
  60.   Gradiant : Real;
  61. Begin
  62.   If ((x1 < x2) AND (y1 < y2)) OR
  63.      ((x1 = x2) AND (y1 < y2)) OR
  64.      ((x1 < x2) AND (y1 = y2)) Then
  65.   Begin
  66.     If (ABS(y2 - y1) + 1) / (ABS(x2 - x1) + 1) <= 1 Then
  67.     Begin
  68.       Gradiant := (ABS(y2 - y1) + 1) / (ABS(x2 - x1) + 1);
  69.       For Loop := x1 To (x1 + ABS(x2 - x1)) Do
  70.         Plot(Loop, (y1 + trunc((Loop - x1) * Gradiant)), Color);
  71.     End
  72.     else
  73.     Begin
  74.       Gradiant := (ABS(x2 - x1) + 1) / (ABS(y2 - y1) + 1);
  75.       For Loop := y1 To (y1 + ABS(y2 - y1)) Do
  76.         Plot((x1 + trunc((Loop - y1) * Gradiant)), Loop, Color);
  77.     End;
  78.   End;
  79.  
  80.   If (x1 > x2) AND (y1 < y2) Then
  81.   Begin
  82.     If (ABS(y2 - y1) + 1) / (ABS(x2 - x1) + 1) <= 1 Then
  83.     Begin
  84.       Gradiant := (ABS(y2 - y1) + 1) / (ABS(x2 - x1) + 1);
  85.       For Loop := x2 To x1 Do
  86.         Plot(Loop, (y1 + trunc((x1 - Loop) * Gradiant)), Color);
  87.     End
  88.     else
  89.     Begin
  90.       Gradiant := (ABS(x2 - x1) + 1) / (ABS(y2 - y1) + 1);
  91.       For Loop := y1 To (y1 + ABS(y2 - y1)) Do
  92.         Plot((x1 + trunc((y1 - Loop) * Gradiant)), Loop, Color);
  93.     End;
  94.   End;
  95.  
  96.   If ((x1 < x2) AND (y1 > y2)) Then
  97.   Begin
  98.     If (ABS(y2 - y1) + 1) / (ABS(x2 - x1) + 1) <= 1 Then
  99.     Begin
  100.       Gradiant := (ABS(y2 - y1) + 1) / (ABS(x2 - x1) + 1);
  101.       For Loop := x1 To (x1 + ABS(x2 - x1)) Do
  102.         Plot(Loop, y1 + trunc((x1 - Loop) * Gradiant), color);
  103.     End
  104.     else
  105.     Begin
  106.       ty := y1;
  107.       y1 := y2;
  108.       y2 := ty;
  109.       Gradiant := (ABS(x2 - x1) + 1) / (ABS(y2 - y1) + 1);
  110.       For Loop := y1 To (y1 + ABS(y2 - y1)) Do
  111.         Plot(x2 + trunc((y1 - Loop) * Gradiant), Loop, color);
  112.     End;
  113.   End;
  114.  
  115.   If ((x1 > x2) AND (y1 > y2)) OR
  116.      ((x1 = x2) AND (y1 > y2)) OR
  117.      ((x1 > x2) AND (y1 = y2)) Then
  118.   Begin
  119.     tx := x1;
  120.     ty := y1;
  121.     x1 := x2;
  122.     y1 := y2;
  123.     x2 := tx;
  124.     y2 := ty;
  125.     If (ABS(y2 - y1) + 1) / (ABS(x2 - x1) + 1) <= 1 Then
  126.     Begin
  127.       Gradiant := (ABS(y2 - y1) + 1) / (ABS(x2 - x1) + 1);
  128.       For Loop := x1 To (x1 + ABS(x2 - x1)) Do
  129.         Plot(Loop, y1 + trunc((Loop - x1) * Gradiant), color);
  130.     End
  131.     else
  132.     Begin
  133.       Gradiant := (ABS(x2 - x1) + 1) / (ABS(y2 - y1) + 1);
  134.       For Loop := y1 To (y1 + ABS(y2 - y1)) Do
  135.         Plot(x1 + trunc((Loop - y1) * Gradiant), Loop, color);
  136.     End;
  137.   End;
  138.  
  139. End;
  140.  
  141. Begin
  142.   InitializeVGA;
  143.  
  144.   SetRGBPalette(1,63, 0, 0);   { RED    }
  145.   SetRGBPalette(2, 0,63, 0);   { GREEN  }
  146.   SetRGBPalette(3, 0, 0,63);   { BLUE   }
  147.   SetRGBPalette(4,63,63,63);   { WHITE  }
  148.  
  149.   For x := 50 To 250 Do
  150.     Line(150, 100, x, 50, 1);
  151.   For y := 50 To 150 Do
  152.     Line(150, 100, 250, y, 2);
  153.   For x := 250 Downto 50 Do
  154.     Line(150, 100, x, 150, 3);
  155.   For y := 150 Downto 50 Do
  156.     Line(150, 100, 50, y, 4);
  157.  
  158.   Readln;
  159. End.
  160.